home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / bbskt30a.zip / HOST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-10  |  15KB  |  563 lines
  1. {
  2.   Host.Pas
  3.  
  4.   A sample host BBS for BBSkit.
  5.  
  6.   Version 1.2, updated for BBSkit 3.0.
  7.  
  8.   Written by Steve Madsen.
  9.  
  10.   NOTE: intended to be compiled using the registered version of BBSkit.  If
  11.   you wish to recompile with a demo copy, remove the space before the $ in
  12.   the following $DEFINE.
  13. }
  14.  
  15. { $DEFINE DEMO}
  16.  
  17. {$X+,V-}
  18.  
  19. PROGRAM Host12;
  20.  
  21. {$DEFINE NOBSP}
  22.  
  23. Uses DOS, CRT, BBSkit, Comm, Util, Protocol, MTask;
  24.  
  25. Const
  26.   Version = '1.2';
  27.  
  28. Type
  29.   THost = object(TBBS)
  30.     Password   : String[20];
  31.     ChatReason : String[40];
  32.     InChat     : Boolean;
  33.     PromptSt   : String[80];
  34.  
  35.     CONSTRUCTOR Init;
  36.     PROCEDURE Run; VIRTUAL;
  37.     DESTRUCTOR Done; VIRTUAL;
  38.     FUNCTION Chat : Boolean;
  39.     FUNCTION HandleVirtualKey(Code : Char) : Boolean; VIRTUAL;
  40.     PROCEDURE UserSession;
  41.     FUNCTION Menu : Boolean;
  42.     PROCEDURE ListFiles;
  43.     PROCEDURE ShowFile;
  44.     PROCEDURE Upload;
  45.     PROCEDURE Download;
  46.     PROCEDURE ChatRequest;
  47.   end;
  48.  
  49. Var
  50.   Host : THost;
  51.  
  52. {********************************************************************}
  53.  
  54.   {
  55.   *  PROCEDURE GetScreenStr
  56.   *
  57.   *  Gets a string of text (no attributes) from the screen and stores
  58.   *  it in Strn.
  59.   }
  60.  
  61. PROCEDURE GetScreenStr(X, Y, Len : Byte; var Strn : String);
  62.  Var
  63.    Idx  : Byte;
  64.    Ch   : Char;
  65.    Attr : Byte;
  66.  
  67.  begin
  68.    Strn := '';
  69.    for Idx := X to X + Len - 1 do
  70.     begin
  71.       GetScreenWord(Idx, Y, Ch, Attr);
  72.       Strn := Strn + Ch;
  73.     end;
  74.  end;
  75.  
  76. {--------------------------------------------------------------------}
  77.  
  78. PROCEDURE Usage;
  79.  begin
  80.    WriteLn;
  81.    WriteLn('Host usage:');
  82.    WriteLn;
  83.    WriteLn('HOST <comport> <baudrate>');
  84.    WriteLn;
  85.    WriteLn(' <comport> can be 1, 2, 3 or 4.');
  86.    WriteLn(' <baudrate> can be 300, 1200, 2400, 4800, 9600, 19200 or 38400.');
  87.    WriteLn;
  88.    WriteLn('example: HOST 2 2400    { com2, at 2400bps }');
  89.    WriteLn('         HOST 1 9600    { com1, at 9600bps }');
  90.  end;
  91.  
  92. {--------------------------------------------------------------------}
  93.  
  94. CONSTRUCTOR THost.Init;
  95.  Var
  96.    Ch : Char;
  97.  
  98.  begin
  99.    TBBS.Init;
  100.    if (not Exist('FILES')) then
  101.     begin
  102.       vcWriteLn('');
  103.       vcWriteLn('Subdirectory "FILES" not found.');
  104.       vcWriteLn('');
  105.       vcWrite('Create or quit program? (C/Q): ');
  106.       Repeat
  107.         Ch := UpCase(ReadKey);
  108.       Until (Ch = 'C') or (Ch = 'Q');
  109.       if (Ch = 'C') then
  110.        begin
  111.          vcWriteLn('Create');
  112.          MkDir('FILES');
  113.        end
  114.       else
  115.        begin
  116.          vcWriteLn('Quit');
  117.          Halt(1);
  118.        end;
  119.     end;
  120.    OpenPort(StrToInt(ParamStr(1)));
  121.    SetAnswerMode(Answer);
  122.    SetOutput(True, False);
  123.    SetInput(True, False);
  124.    SetFlowControl(PortIdx, True, False);
  125.    ClearIntChars;
  126.    AddIntChar(' ');
  127.    SetVirtualKeys(True);
  128.    ClearVirtualKeys;
  129.    AddVirtualKey(#46);  { alt-C, chat enter/exit }
  130.    vcWriteLn('');
  131.    vcWrite('Today''s password: ');
  132.    ComReadLn(Password, 20);
  133.    Password := Upper(Password);
  134.    ChatReason := '';
  135.    InChat := False;
  136.  end;
  137.  
  138. {--------------------------------------------------------------------}
  139.  
  140. PROCEDURE THost.Run;
  141.  Var
  142.    Quit : Boolean;
  143.  
  144.  begin
  145.    Quit := False;
  146.    ClrScr;
  147.    while (not Quit) do
  148.     begin
  149.       SetBpsRate(PortIdx, StrToInt(ParamStr(2)));
  150.       vcWriteLn('');
  151.       vcWriteLn('Host: Waiting For Call   [SPC] for local login   [Q] to quit');
  152.       while (not LineRinging(PortIdx)) and (not Keypressed) do ;
  153.       if (Keypressed) then
  154.        begin
  155.          case UpCase(ReadKey) of
  156.            ' ' : begin
  157.                    SetInput(True, False);
  158.                    SetOutput(True, False);
  159.                    UserSession;
  160.                  end;
  161.            'Q' : Quit := True;
  162.          end;
  163.        end
  164.       else
  165.        begin
  166.          PickupPhone;
  167.          if (WaitFor('C', 30)) then ;
  168.          if (Carrier(PortIdx)) then
  169.           begin
  170.             SetOutput(True, True);
  171.             SetInput(True, True);
  172.             UserSession;
  173.           end;
  174.        end;
  175.     end;
  176.  end;
  177.  
  178. {--------------------------------------------------------------------}
  179.  
  180. DESTRUCTOR THost.Done;
  181.  begin
  182.    ClosePort(True);
  183.    TBBS.Done;
  184.  end;
  185.  
  186. {--------------------------------------------------------------------}
  187.  
  188. FUNCTION THost.Chat : Boolean;  { chat with user }
  189.  Var
  190.    St       : String;
  191.    Wrap     : String;
  192.  
  193.  begin
  194.    if (not InChat) then
  195.     begin
  196.       InChat := True;
  197.       ChatReason := '';
  198.       PromptSt := '';
  199.       GetScreenStr(1, WhereY, WhereX - 1, PromptSt);
  200.       ComWriteLn('');
  201.       ComWriteLn('');
  202.       ComWrite('Sysop has entered chat mode.');
  203.       vcWrite('  (Sysop: Alt-C to exit)');
  204.       ComWriteLn('');
  205.       ComWriteLn('');
  206.       Wrap := '';
  207.       while (InChat) do
  208.          ComReadLnWrap(St, 79, Wrap);
  209.       Chat := False;
  210.     end
  211.    else
  212.     begin
  213.       InChat := False;
  214.       ComWriteLn('');
  215.       ComWriteLn('');
  216.       ComWriteLn('Sysop has exited chat mode.');
  217.       ComWriteLn('');
  218.       ComWrite(PromptSt);
  219.       Chat := True;
  220.     end;
  221.  end;
  222.  
  223. {--------------------------------------------------------------------}
  224.  
  225. FUNCTION THost.HandleVirtualKey(Code : Char) : Boolean;
  226.  begin
  227.    case Code of
  228.      #46 : HandleVirtualKey := Chat;
  229.    end;
  230.  end;
  231.  
  232. {--------------------------------------------------------------------}
  233.  
  234. PROCEDURE THost.UserSession;
  235.  Var
  236.    Pass : String[20];
  237.    Try  : Byte;
  238.  
  239.  begin
  240.    SetLF(True);
  241.    ComWriteLn('');
  242.    ComWriteLn('BBSkit Host v' + Version);
  243.    Try := 0;
  244.    Pass := '';
  245.    while (Try < 4) and (Pass <> Password) do
  246.     begin
  247.       Inc(Try);
  248.       ComWriteLn('');
  249.       ComWrite('Password: ');
  250.       SetEcho('*');
  251.       ComReadLn(Pass, 20);
  252.       SetEcho(#0);
  253.       Pass := Upper(Pass);
  254.       ComWriteLn('');
  255.       if (Pass <> Password) then ComWriteLn('Incorrect.');
  256.     end;
  257.    if (Pass = Password) then
  258.     begin
  259.       ComWriteLn('');
  260.       ComWriteLn('Welcome to BBSkit Host.');
  261.       ComWriteLn('');
  262.       while (Menu) do ;
  263.     end;
  264.    Hangup;
  265.  end;
  266.  
  267. {--------------------------------------------------------------------}
  268.  
  269. FUNCTION THost.Menu : Boolean;
  270.  Var
  271.    Cmd : Char;
  272.  
  273.  begin
  274.    Menu := True;
  275.    vcWrite('Sysop: Alt-C enters chat mode');
  276.    if (ChatReason <> '') then
  277.       vcWrite('   WANTS CHAT: ' + ChatReason);
  278.    vcWriteLn('');
  279.    ComWrite('[L]ist files  [T]ype file  [U]pload  [D]ownload  [C]hat  [G]oodbye: ');
  280.    Cmd := UpCase(ComReadKey);
  281.    ComWriteLn(Cmd);
  282.    case Cmd of
  283.      'L' : ListFiles;
  284.      'T' : ShowFile;
  285.      'U' : Upload;
  286.      'D' : Download;
  287.      'C' : ChatRequest;
  288.      'G' : begin
  289.              ComWriteLn('');
  290.              ComWrite('Sure? ');
  291.              Repeat
  292.                Cmd := UpCase(ComReadKey);
  293.              Until (Cmd = 'Y') or (Cmd = 'N');
  294.              ComWriteLn(Cmd);
  295.              if (Cmd = 'Y') then
  296.               begin
  297.                 Menu := False;
  298.                 ComWriteLn('');
  299.                 ComWriteLn('Goodbye...');
  300.               end;
  301.              ComWriteLn('');
  302.            end;
  303.    end;
  304.  end;
  305.  
  306. {--------------------------------------------------------------------}
  307.  
  308. PROCEDURE THost.ListFiles;
  309.  Var
  310.    FInfo : SearchRec;
  311.    FTime : DateTime;
  312.    Name  : String[8];
  313.    Ext   : String[3];
  314.  
  315.  begin
  316.    ComWriteLn('');
  317.    ComWriteLn('Listing of all available files:');
  318.    ComWriteLn('');
  319.    FindFirst('FILES\*.*', Archive OR ReadOnly, FInfo);
  320.    while (DOSError = 0) do
  321.     begin
  322.       Name := Copy(FInfo.Name, 1, Pos('.', FInfo.Name) - 1);
  323.       Ext := Copy(FInfo.Name, Pos('.', FInfo.Name) + 1, 3);
  324.       UnpackTime(FInfo.Time, FTime);
  325.       ComWrite(Left(Name, 8) + '.' + Left(Ext, 3) + '    ');
  326.       ComWrite(Right(IntToStr(FInfo.Size), 7) + ' bytes    ');
  327.       if (FTime.Hour < 10) then ComWrite('0');
  328.       ComWrite(IntToStr(FTime.Hour) + ':');
  329.       if (FTime.Min < 10) then ComWrite('0');
  330.       ComWriteLn(IntToStr(FTime.Min));
  331.       FindNext(FInfo);
  332.     end;
  333.    ComWriteLn('');
  334.  end;
  335.  
  336. {--------------------------------------------------------------------}
  337.  
  338. PROCEDURE THost.ShowFile;
  339.  Var
  340.    Fname : String[12];
  341.